home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / ad.arc / ADREAD.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  5.6 KB  |  123 lines
  1. 1000  RUN A$
  2. 5000  CLS:LOCATE 25,1:COLOR 0,7,1:PRINT C$;:COLOR 3,0:LOCATE 1,1:RETURN
  3. 35020  IF SND$="N" THEN RETURN ELSE BEEP:RETURN
  4. 35030  IF SND$="N" THEN RETURN ELSE SOUND 750,2:SOUND 30000,2:SOUND 750,2:RETURN
  5. 40000  JJ=0:GNAME=0:ON KEY(2) GOSUB 1000:KEY(2) ON
  6. 40100  IF A$="ADMAIL.BAS" THEN B$="MAILING" :C$="F KEY:  F2 = MAILING labels menu":DG=1 ELSE B$="ROLODEX":C$="F KEY: F2 ROLODEX labels menu":DG=0
  7. 40120  DEF SEG=0: POKE 1050, PEEK(1052):GOTO 40140
  8. 40130  IF JJ=0 THEN 1000 ELSE CHAIN A$,1960,ALL
  9. 40140   X1$="PRINT - ROLODEX ":X3$="FILE = ":X5$="FUNCTION = ":X4$=SPACE$(30):Q$=CHR$(27)
  10. 40150  MS=0:GOSUB 5000
  11. 40160  COLOR 3,0,1:LOCATE 1,1:PRINT "PRINT ";B$ ;:PRINT " LABELS ... ":LOCATE 3,28 :COLOR 12,0:PRINT "ENTER:  SURNAME & ";ARR$:COLOR 3,0:LOCATE 5,13:PRINT  "(full name or any part starting from left most character)"
  12. 40170  LOCATE 4,18:PRINT "(Be sure the file has been sorted by SURNAME)"
  13. 40180  LOCATE 6,39:PRINT "OR":LOCATE 6,23:COLOR 12,0:PRINT "[!] & ";ARR$;" TO EXAMINE complete file":COLOR 3,0
  14. 40190  LOCATE 7,39:PRINT "OR":LOCATE 8,35:PRINT ARR$;"  EXIT"
  15. 40200  COLOR 15,0:LOCATE 20,32: INPUT "SURNAME ... ",S$:MM=LEN(S$):IF MM=0 THEN 40130
  16. 40210  IF NN=0 THEN 40130:GOSUB 5000
  17. 40220  GOSUB 41080:GOSUB 41120
  18. 40230  GET #4,NN+1:K=VAL(V$(16)):K1=K:II=1:I1=0
  19. 40240  IF S$="!" THEN 40260 ELSE QK=ASC(LEFT$(S$,1)):IF QK>90 OR QK<65 THEN 40460 ELSE K=ZK(QK-64)
  20. 40250  IF K=0 THEN 40460
  21. 40260  LOCATE 1,70:COLOR 16,7:PRINT " WORKING ":COLOR 3,0:I1=I1+1:TEST=0:GET #4, K
  22. 40270  IF S$="!" THEN 40290
  23. 40280  GNAME=1:IF S$<>MID$(V$(2),5,MM) THEN 40410
  24. 40290  LOCATE 1,70:PRINT SPACE$(9):GOSUB 40800
  25. 40300  MS=1:IF FRE(1)<800 THEN CHAIN "ADRODX.bas",1230,ALL
  26. 40310  IF Y$="S" OR Y$="s" THEN 40130
  27. 40320  IF Y$="I" THEN K=VAL(V$(15)) ELSE 40340
  28. 40330  IF II=1  THEN II=NN:GOTO 40430 ELSE II=II-1:GOTO 40260
  29. 40340  IF (Y$="N" OR Y$="n" OR Y$="Q")  THEN K=VAL(V$(14)) ELSE 40360
  30. 40350  IF II=NN THEN II=1:GOTO 40430 ELSE II=II+1 :GOTO 40430
  31. 40360  IF Y$="G" THEN K=K1:II=1:GOTO 40260
  32. 40370  IF Y$="=" THEN GOSUB 40630:GOTO 40260
  33. 40380  IF Y$="-" THEN GOSUB 40520:GOTO 40300
  34. 40390  IF Y$="+" THEN GOSUB 40520:GOTO 40300
  35. 40400  IF Y$="O" THEN GET #4,K1:K=VAL(V$(15)):II=NN:GOTO 40260
  36. 40410  IF ZTEST=26 THEN K=VAL(V$(14)):GOTO 40440
  37. 40420  IF ASC(MID$(V$(2),5,1))<>QK THEN 40450 ELSE K=VAL(V$(14))
  38. 40430  IF S$="!" THEN 40260
  39. 40440  IF I1=NN THEN 40450 ELSE 40260
  40. 40450  IF MS=1 THEN 40480
  41. 40460  LOCATE 22,1:PRINT "Person is not in the address book. Try again.  Hit any key to continue."
  42. 40470  Y$=INKEY$:IF Y$="" THEN 40470 ELSE 40150
  43. 40480  CLS:LOCATE 12,25:PRINT "ANY MORE CHANGES?  <Y> or <N> ":COLOR 15,0:LOCATE 12,45:PRINT "Y":LOCATE 12,52:PRINT "N":COLOR 3,0:GOSUB 40120
  44. 40490  IF Y$="N" THEN ED$="":GOTO 40140
  45. 40500  IF Y$="Y" OR Y$="y" THEN 40150
  46. 40510  CLS
  47. 40520  IS=II:LOCATE 1,70:COLOR 16,7:PRINT " WORKING ":COLOR 3,0
  48. 40530  NII=ABS(NI):FOR NF = 1 TO NII
  49. 40540  DEF SEG=&H40:IF PEEK(&H17) AND 16 THEN 40610
  50. 40550  IF NI<0 OR Y$="-" THEN II=IS-NF:K=VAL(V$(15)):GET #4,K:GOTO 40560 ELSE K=VAL(V$(14)):GET #4,K:II=IS+NF
  51. 40560  IF II=<0 THEN II=NN+II
  52. 40570  IF II>NN THEN II=ABS(II-NN)
  53. 40580  GOSUB 40800:NEXT
  54. 40590  LOCATE 23,20:PRINT SPACE$(40)
  55. 40600  Y$="":LOCATE 1,70:PRINT SPACE$(9):GOTO 40830
  56. 40610  LOCATE 23,20:PRINT SPACE$(40)
  57. 40620  Y$="":LOCATE 1,70:PRINT SPACE$(9):GOTO 40830
  58. 40630  IF NUM=<0 OR NUM>NN THEN GOSUB 35020:LOCATE 23,20:PRINT "REENTER NUMBER BETWEEN 1 - ";NN;"  ";SPACE$(5):ELSE 40650
  59. 40640  GOSUB 35030:DEF SEG =&H40:POKE &H17,PEEK(&H17) OR 32:LOCATE 23,51:INPUT NUM:DEF SEG=&H40:POKE &H17,PEEK(&H17) AND 223
  60. 40650  IF NUM=<0 OR NUM>NN THEN 40630 ELSE LOCATE 23,20:PRINT SPACE$(50)
  61. 40660  IF ABS(NUM-II)<10 AND NUM-II<0 THEN NZ=II-1:K=VAL(V$(15)):GOTO 40760
  62. 40670  IF NUM-II<10 AND NUM-II >=0 THEN NZ=II+1:K=VAL(V$(14)):LOCATE 23,20:PRINT SPACE$(50):GOTO 40720
  63. 40680  K=ZK(27):NZ=INT((NN/10)+0.5):IF NN<10*NZ THEN NZ=INT(NN/10)
  64. 40690  FOR IZ=1 TO 10:IF NUM=<IZ*NZ THEN K=ZK(IZ+26):NZ=(IZ-1)*NZ:IZ=10
  65. 40700  NEXT
  66. 40710  IF K=ZK(27) AND NZ=INT(NN/10) THEN K=ZK(36):NZ=10*NZ
  67. 40720  LOCATE 1,70:COLOR 16,7:PRINT " WORKING ":COLOR 3,0
  68. 40730  FOR II=NZ TO NUM-1 :GET #4,K:K=VAL(V$(14)):NEXT
  69. 40740  LOCATE 1,70:PRINT SPACE$(9)
  70. 40750  RETURN
  71. 40760  LOCATE 23,20:PRINT SPACE$(50)
  72. 40770  LOCATE 1,70:COLOR 16,7:PRINT " WORKING ":COLOR 3,0
  73. 40780  FOR II=NZ TO NUM+1 STEP -1:GET #4,K:K=VAL(V$(15)):NEXT
  74. 40790  LOCATE 1,70:PRINT SPACE$(9):RETURN
  75. 40800  REM
  76. 40810  COLOR 3,0:LOCATE 1,15:PRINT II;SPACE$(3):GOSUB 41250
  77. 40820  IF Y$="+" OR Y$="-" THEN RETURN
  78. 40830  COLOR 3,0:DEF SEG=0: POKE 1050, PEEK(1052):GOSUB 35020
  79. 40840  Y$=INKEY$:IF Y$="" THEN 40840
  80. 40850  DEF SEG=&H40:POKE &H17, 0
  81. 40860  IF LEN(Y$)=2 THEN Y$=RIGHT$(Y$,1)
  82. 40870  IF Y$="Y" OR Y$="y" THEN I=II:GOTO 41020
  83. 40880  IF S$<>"!" THEN 41010 ELSE IF Y$="s" OR Y$="S" THEN RETURN
  84. 40890  IF Y$="=" THEN COLOR 14,0:LOCATE 23,20:PRINT "Jump to (1 - ";NN;" ) ... ";ARR$; ELSE 40910
  85. 40900  GOSUB 35030:DEF SEG =&H40:POKE &H17,PEEK(&H17) OR 32:INPUT NUM:DEF SEG=&H40:POKE &H17,PEEK(&H17) AND 223:RETURN
  86. 40910  IF Y$="G" THEN JK=I:I=0:RETURN
  87. 40920  IF Y$="O" THEN JK=I:I=NN-1:RETURN
  88. 40930  IF Y$="I" THEN JK=I:I=I-2:RETURN
  89. 40940  IF Y$="-" THEN COLOR 14,0:LOCATE 23,20:PRINT "GO back #? ";ARR$;:GOTO 40960
  90. 40950  IF Y$="+" THEN COLOR 14,0:LOCATE 23,20:PRINT "GO forward #? ";ARR$; ELSE 41000
  91. 40960  GOSUB 35030:DEF SEG =&H40:POKE &H17,PEEK(&H17) OR 32
  92. 40970  INPUT " ",NI:JK=I:I=NI:NI=ABS(NI):COLOR 3,0
  93. 40980  IF ABS(NI)>NN THEN LOCATE 23,20:GOSUB 35030:PRINT "OUTSIDE DATA RANGE.  1 TO";NN;:FOR K=1 TO 900:NEXT:LOCATE 23,10:PRINT SPACE$(68):I=JK:GOTO 40840
  94. 40990  DEF SEG=&H40:POKE &H17,PEEK(&H17) AND 223:LOCATE 23,10:PRINT SPACE$(65):LOCATE 23,21:COLOR 0,7:PRINT "Hit <Scroll Lock> to stop at a RECORD.":COLOR 3,0:RETURN
  95. 41000  IF (Y$="N" OR Y$="n" OR Y$="Q")  THEN JK=I:RETURN ELSE 40830
  96. 41010  IF Y$="N" OR Y$="n" THEN JK=I:RETURN ELSE 40830
  97. 41020  JJ=JJ+1:D%(JJ)=VAL(V$(16)):IF GNAME=1 THEN I=K:RETURN ELSE K=VAL(V$(14)):IF I=NN THEN II=1 :RETURN 40260 ELSE II=1+II:RETURN 40260
  98. 41030  FOR J= 1 TO 13:K=W(J):B$(J)=D$(K):NEXT:GOTO 41040
  99. 41035  FOR J = 1 TO 13:K=W(J):B$(J)=MID$(V$(K),5,VAL(V$(K))):NEXT
  100. 41040  GOSUB 5000:LOCATE 22,13
  101. 41070  RETURN
  102. 41080  GOSUB 5000
  103. 41090  COLOR 3,0,1:PRINT "RECORD #:  ":PRINT:PRINT "NAME:          ":FOR J= 3 TO 8:PRINT Q$(J):NEXT:PRINT Q$(13):FOR J= 9 TO 12:PRINT Q$(J):NEXT:RETURN
  104. 41100  LOCATE 1,15:PRINT SPACE$(50)
  105. 41110  FOR J= 2 TO 13:LOCATE 1+J,15:PRINT SPACE$(50):NEXT:RETURN
  106. 41120  REM
  107. 41130  COLOR 3,0:LOCATE 18,1:PRINT "Print Label?  <Y>es.":COLOR 14,0:LOCATE 18,16:PRINT "Y":COLOR 3,0
  108. 41140  IF S$="!" THEN LOCATE 19,15:PRINT "<PgDn> or <N>o - next record.":LOCATE 19,26:COLOR 14,0:PRINT "N" :LOCATE 19,16:PRINT "PgDn" ELSE LOCATE 19,15:PRINT "<N>o.":LOCATE 19,16:COLOR 14,0:PRINT "N"
  109. 41150  IF S$<> "!" THEN RETURN ELSE COLOR 3,0:LOCATE 20,15:PRINT "<PgUp> - previous record":LOCATE 21,15:PRINT "<+> Scan forward ":COLOR 14,0:LOCATE 20,16:PRINT "PgUp":LOCATE 21,16:PRINT "+"
  110. 41160  LOCATE 19,50:COLOR 3,0:PRINT "<Home> - First record.":LOCATE 19,51:COLOR 14,0:PRINT "Home" :COLOR 3,0:LOCATE 20,50:PRINT "<End> - Last record.":LOCATE 20,51:COLOR 14,0:PRINT "End"
  111. 41170  COLOR 3,0:LOCATE 21,50:PRINT "<-> Scan backward":LOCATE 21,51:COLOR 14,0:PRINT "-":COLOR 3,0
  112. 41180  COLOR 3,0:LOCATE 22,15:PRINT "<=> Jump ":LOCATE 22,16:COLOR 14,0:PRINT "=":COLOR 3,0
  113. 41190  LOCATE 22,50:PRINT "<";:COLOR 14,0:PRINT "S";:COLOR 3,0:PRINT "> Start PRINTING";:COLOR 14,0:PRINT "?":COLOR 3,0:RETURN
  114. 41200  COLOR 11,0:LOCATE 3,15:PRINT SPACE$(50):LOCATE 3,15:PRINT D$(13);D$(1);" ";D$(2)
  115. 41210  FOR J= 3 TO 11:K=W(J):IF J>8 THEN JK=J+2 ELSE JK=J+1
  116. 41220  LOCATE JK,15:PRINT D$(K);SPACE$(35-LEN(D$(K))):NEXT
  117. 41230  LOCATE 14,15:PRINT SPACE$(64):PRINT SPACE$(80):LOCATE 14,15:PRINT D$(9):RETURN
  118. 41240  LOCATE 14,15:PRINT SPACE$(64):PRINT SPACE$(80):LOCATE 14,15:PRINT MID$(V$(9),5,VAL(V$(9))):RETURN
  119. 41250  COLOR 11,0:LOCATE 3,15:PRINT SPACE$(50):LOCATE 3,15:PRINT MID$(V$(13),5,VAL(V$(13)));MID$(V$(1),5,VAL(V$(1)));" ";MID$(V$(2),5,VAL(V$(2)))
  120. 41260  FOR J= 3 TO 11:K=W(J):IF J>8 THEN JK=J+2 ELSE JK=J+1
  121. 41270  LOCATE JK,15:PRINT MID$(V$(K),5,VAL(V$(K)));SPACE$(30):NEXT
  122. 41280  LOCATE 14,15:PRINT SPACE$(64):PRINT SPACE$(80):LOCATE 14,15:PRINT MID$(V$(9),5,VAL(V$(9))):RETURN
  123.